<%@LANGUAGE="VBSCRIPT" CODEPAGE="932"%> <% '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' result.asp '---------------------------------------------------- ' 処　理:検索結果一覧画面 '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* Option Explicit Response.Buffer = True %> <% '--- 共通変数 ---- dim mintTotalPage '全体ページ数 dim mintCurrentPage '現在のページ dim mintHitCount '検索結果レコード数 dim mintDispCount '表示レコード数 dim mintDefCount '最大表示行数 dim mintTotalCount '総件数 dim mstrKensaku '検索文字列 dim marrItems() dim mintSort1 'Sort順 dim mintSort2 'Sort順 dim cn 'Connection Object dim rs 'RecordSet Object dim marrKw(10) call Main() sub Main() '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' Main '---------------------------------------------------- ' 処　理:　メインルーチン '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim flg dim strSQL 'SQL文字列 dim strTmp dim i 'カウント dim strErrMsg '-- 変数初期化 flg=false i=0 if isArray(session("SRC"))=false then response.redirect("index.asp?STO=T") response.end else for each strTmp in session("SRC") marrKw(i)=strTmp i=i+1 next end if '-- 検索項目の入力が無かった場合、タイムアウトと判断し、TOPに戻る for i=lbound(marrKW) to ubound(marrKW)-1 if marrKw(i)<>"" then flg = true end if next if flg=false then response.redirect("index.asp?STO=TW") response.end else '-- 不正入力チェック if fncInputCheck() then response.redirect("index.asp?STO=ERR") response.end end if end if '-- 表示行数 if request.Form("selLine")<>"" then mintDefCount=cint(request.Form("selLine")) elseif request.QueryString("DLINE")<>"" then mintDefCount=cint(request.QueryString("DLINE")) end if if mintDefCount<>10 and mintDefCount<>30 and mintDefCount<>50 and mintDefCount<>100 then mintDefCount = 10 end if '-- 並び順指定 if request.form("S1")="" then mintSort1 = cint(request.querystring("S1")) mintSort2 = cint(request.querystring("S2")) else mintSort1 = cint(request.form("S1")) mintSort2 = cint(request.form("S2")) end if if mintSort1<1 or mintSort1>3 then mintSort1=1 mintSort2=2 end if if mintSort2<>1 and mintSort2<>2 then mintSort2=2 end if '-- DB Connect if dbConnect(strErrMsg,cn) = false then call dispErrWrite(strErrMsg) exit sub end if '-- レコードセット Set rs = Server.CreateObject("ADODB.RecordSet") '-- 総件数取得 strSQL ="SELECT COUNT(ID) AS DCNT FROM TBL_REPORT" rs.Open strSQL, cn, adOpenStatic, adLockReadOnly mintTotalCount=rs("DCNT") rs.close '-- SQL文字列生成 strSQL= fncMakeSQL '-- 各項目の値を取得 call subGetItems(strSQL) '-- 検索結果表示 call subDispBody end sub function fncInputCheck() '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' fncInputCheck(msg) '---------------------------------------------------- '処　理：入力チェック '引　数：なし '戻り値：True エラー有　False　正常終了 '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim blnRet dim blnInputChk dim i dim BaspObj dim intFm dim intTo '初期化 blnRet=false blnInputChk=false set BaspObj = createobject("BASP21") '値のチェック for i=0 to 3 if marrKw(i)<>"" and isnull(marrKw(i))=false then if isnumeric(marrKw(i))=false then blnRet=true else select case i case 0,1 intFm=1000 intTo=9999 case 2,3 intFm=1 intTo=99 end select if cint(marrKw(i))< cint(intFm) or cint(marrKw(i)) > cint(intTo) then blnRet=true end if end if blnInputChk=true end if next for i=4 to 6 if marrKw(i)<>"" and isnull(marrKw(i))=false then '-- 半角文字 (1 バイト) を全角文字 (2 バイト) に変換 marrKw(i)=BaspObj.StrConv(marrKw(i),4) if len(marrKw(i))>100 then blnRet=true else blnInputChk=true end if end if next if marrKw(8)<>"NO_DATA" then blnInputChk=true end if if isnumeric(marrKw(9)) then if cint(marrKw(9))>3 or cint(marrKw(9))<-1 then blnRet=true end if else blnRet=true end if if isnumeric(marrKw(10)) then if cint(marrKw(10))>3 or cint(marrKw(10))<-1 then blnRet=true end if else blnRet=true end if set BaspObj=nothing if blnInputChk=false then blnRet=true end if fncInputCheck=blnRet end function function fncMakeSQL() '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' fncMakeSQL() '---------------------------------------------------- '処　理：SQL文作成 '戻り値：SQL文字列 '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim strRetSQL, strSQL1, strSQL2 dim strRonri dim strSQLKw, strSQLTl, strSQLPr, strSQLYy, strSQLGo, strSQLCtg dim i dim arrKwTitle, arrKwKeyword, arrKwReporter, arrCheckBox '-- 変数初期化 strSQLKw="" strSQLTl="" strSQLPr="" strSQLYy="" strSQLGo="" strSQLCtg="" strSQL1 = "SELECT * FROM TBL_REPORT WHERE " '-- タイトル if marrKw(4)<>"" and isnull(marrKw(4))=false then mstrKensaku="タイトル：" & marrKw(4) & "
" arrKwTitle=split(marrKw(4),"　",-1,1) for i=lbound(arrKwTitle) to ubound(arrKwTitle) if i=0 then strSQLTl = strSQLTl & " (fld_title LIKE '%" & arrKwTitle(i) & "%')" else strSQLTl = strSQLTl & " AND (fld_title LIKE '%" & arrKwTitle(i) & "%')" end if next end if '-- キーワード if marrKw(5)<>"" and isnull(marrKw(5))=false then mstrKensaku=mstrKensaku & "キーワード：" & marrKw(5) & "
" arrKwKeyword=split(marrKw(5),"　",-1,1) for i=lbound(arrKwKeyword) to ubound(arrKwKeyword) if i=0 then strSQLKw = strSQLKw & " (fld_keyword LIKE '%" & arrKwKeyword(i) & "%')" else strSQLKw = strSQLKw & " AND (fld_keyword LIKE '%" & arrKwKeyword(i) & "%')" end if next end if '-- 報告者 if marrKw(6)<>"" and isnull(marrKw(6))=false then mstrKensaku=mstrKensaku & "報告者：" & marrKw(6) & "
" arrKwReporter=split(marrKw(6),"　",-1,1) for i=lbound(arrKwReporter) to ubound(arrKwReporter) if i=0 then strSQLPr = strSQLPr & " (fld_reporter LIKE '%" & arrKwReporter(i) & "%')" else strSQLPr = strSQLPr & " AND (fld_reporter LIKE '%" & arrKwReporter(i) & "%')" end if next end if '-- 発行年 if marrKW(0)<>"" then if marrKW(9)="" or isnull(marrKW(9))="" then marrKW(9)=0 end if select case cstr(marrKW(9)) case "0" strSQLYy = strSQLYy & "(fld_nen = " & marrKW(0) & ") " mstrKensaku=mstrKensaku & "発行年：" & marrKW(0) & "
" case "1" strSQLYy = strSQLYy & "(fld_nen BETWEEN " & marrKW(0) & " AND " & marrKW(1) & ") " mstrKensaku=mstrKensaku & "発行年：" & marrKW(0) & "〜" & marrKW(1) & "
" case "2" strSQLYy = strSQLYy & "(fld_nen >= " & marrKW(0) & ") " mstrKensaku=mstrKensaku & "発行年：" & marrKW(0) & "〜
" case "3" strSQLYy = strSQLYy & "(fld_nen <= " & marrKW(0) & ") " mstrKensaku=mstrKensaku & "発行年：〜" & marrKW(0) & "
" end select end if '-- 記載号 if marrKW(2)<>"" then if marrKW(10)="" or isnull(marrKW(10))="" then marrKW(10)=0 end if select case cstr(marrKW(10)) case "0" strSQLGo = strSQLGo & "(fld_go = " & marrKW(2) & ") " mstrKensaku=mstrKensaku & "記載号：" & marrKW(2) & "
" case "1" strSQLGo = strSQLGo & "(fld_go BETWEEN " & marrKW(2) & " AND " & marrKW(3) & ") " mstrKensaku=mstrKensaku & "記載号：" & marrKW(2) & "〜" & marrKW(3) & "
" case "2" strSQLGo = strSQLGo & "(fld_go >= " & marrKW(2) & ") " mstrKensaku=mstrKensaku & "記載号：" & marrKW(2) & "〜
" case "3" strSQLGo = strSQLGo & "(fld_go <= " & marrKW(2) & ") " mstrKensaku=mstrKensaku & "記載号：〜" & marrKW(2) & "
" end select end if '-- チェックボックス if marrKW(8)<>"NO_DATA" then arrCheckBox=split(marrKW(8),",",-1,1) for i=lbound(arrCheckBox) to ubound(arrCheckBox) if i=0 then strSQLCtg = strSQLCtg & " (fld_category=" & arrCheckBox(i) & ")" mstrKensaku=mstrKensaku & "分野：" & getCategory(arrCheckBox(i)) else strSQLCtg = strSQLCtg & " OR (fld_category=" & arrCheckBox(i) & ")" mstrKensaku=mstrKensaku & "/" & getCategory(arrCheckBox(i)) end if next mstrKensaku=mstrKensaku & "
" end if '-- AND/OR select case marrKW(7) case "O" strRonri="OR" case else strRonri="AND" end select '-- SQL文組み立て if strSQLTl<>"" then strSQL2= "(" & strSQLTl & ") " end if if strSQLKw<>"" then if strSQL2="" then strSQL2=strSQL2 & "(" & strSQLKw & ") " else strSQL2=strSQL2 & strRonri & " (" & strSQLKw & ") " end if end if if strSQLPr<>"" then if strSQL2="" then strSQL2=strSQL2 & "(" & strSQLPr & ") " else strSQL2=strSQL2 & strRonri & " (" & strSQLPr & ") " end if end if if strSQLYy<>"" then if strSQL2="" then strSQL2=strSQL2 & "(" & strSQLYy & ") " else strSQL2=strSQL2 & strRonri & " (" & strSQLYy & ") " end if end if if strSQLGo<>"" then if strSQL2="" then strSQL2=strSQL2 & "(" & strSQLGo & ") " else strSQL2=strSQL2 & strRonri & " (" & strSQLGo & ") " end if end if if strSQLCtg<>"" then if strSQL2="" then strSQL2=strSQL2 & "(" & strSQLCtg & ") " else strSQL2=strSQL2 & strRonri & " (" & strSQLCtg & ") " end if end if '-- 並び替え項目 strRetSQL = strSQL1 & strSQL2 & fncGetSortString fncMakeSQL = strRetSQL end function function getCategory(ctg) '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' getCategory(ctg) '---------------------------------------------------- '処　理：分野をｺｰﾄﾞから文字列取得 '引　数：分野のｺｰﾄﾞ '戻り値：分野の文字列 '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim strSQL 'SQL文字列 dim ret dim rs2 if isnumeric(ctg) then strSQL ="SELECT STR FROM MST_CATEGORY WHERE CODE=" & ctg & ";" Set rs2 = Server.CreateObject("ADODB.RecordSet") rs2.Open strSQL, cn, adOpenStatic, adLockReadOnly if rs2.recordcount=0 then ret="" else ret=rs2("STR") end if rs2.close else ret="" end if getCategory=ret end function function fncGetSortString() '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' fncGetSortString '---------------------------------------------------- '処　理：ソート順SQL取得 '戻り値：ソート順SQL '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim strRet strRet="" '並び替え項目 select case true case mintSort1 = 1 AND mintSort2 = 1 '発行年昇順 strRet = strRet & "ORDER BY fld_nen, ID;" case mintSort1 = 1 AND mintSort2 = 2 '発行年降順 strRet = strRet & "ORDER BY fld_nen DESC, ID;" case mintSort1 = 2 AND mintSort2 = 1 '記載号昇順 strRet = strRet & " ORDER BY fld_go, ID;" case mintSort1 = 2 AND mintSort2 = 2 '記載号降順 strRet = strRet & " ORDER BY fld_go DESC, ID;" case mintSort1 = 3 AND mintSort2 = 1 'タイトル昇順 strRet = strRet & " ORDER BY fld_title, ID;" case mintSort1 = 3 AND mintSort2 = 2 'タイトル降順 strRet = strRet & " ORDER BY fld_title DESC, ID;" case else 'ありえないが念のため strRet = strRet & "ORDER BY fld_nen DESC, ID;" end select fncGetSortString=strRet end function function fncCurrentPage() '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' fncCurrentPage '---------------------------------------------------- '処　理：カレントページの取得 '戻り値：カレントページ '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim intNowPg '現在ページ '現在ページの入力チェック if request.QueryString("PAGE")="" then intNowPg=1 elseif isnumeric(request.QueryString("PAGE")) =false then intNowPg=1 elseif request.Form("selLine")<>"" then intNowPg=1 elseif request.Form("S1")<>"" then intNowPg=1 elseif request.Form("S2")<>"" then intNowPg=1 else intNowPg=cint(request.QueryString("PAGE")) end if '現在位置が１ページ以降で「先頭ページ」が押されたとき if request.querystring("PG")="F" then intNowPg=1 end if '現在位置が１ページ以降で「前ページ」が押されたとき if request.querystring("PG")="P" and intNowPg>1 then intNowPg=intNowPg-1 end if '現在位置が最終ページ前で「次ページ」が押されたとき if request.querystring("PG")="N" and intNowPgmintTotalPage then intNowPg=1 end if fncCurrentPage = cint(intNowPg) end function function fncParam() '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' fncParam '---------------------------------------------------- '処　理：パラメータの作成 '戻り値：パラメータ '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim strTxt strTxt="" if mintCurrentPage<>"" then strTxt=strTxt & "&PAGE=" & mintCurrentPage end if if mintDefCount<>"" then strTxt=strTxt & "&DLINE=" & mintDefCount end if if mintSort1<>"" then strTxt=strTxt & "&S1=" & mintSort1 end if if mintSort2<>"" then strTxt=strTxt & "&S2=" & mintSort2 end if '１文字目の「&」を削除 if left(strTxt,1)="&" then strTxt=right(strTxt,len(strTxt)-1) end if fncParam=strTxt end function sub subGetItems(ByVal strSQL) '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' subGetItems() '---------------------------------------------------- '処　理：各項目の値を取得し表示用に変換する '引　数：SQL文 '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim tmpDate rs.Open strSQL, cn, adOpenStatic, adLockReadOnly '-- 検索結果数の取得 mintHitCount=rs.recordcount '-- ページ総数の取得 rs.PageSize= mintDefCount mintTotalPage=rs.PageCount if mintTotalPage=0 then mintTotalPage=1 end if '-- 現在のページの取得 mintCurrentPage=fncCurrentPage '-- ページ内の情報を格納 erase marrItems mintDispCount=0 if mintHitCount=0 then rs.close exit sub end if rs.AbsolutePage=mintCurrentPage '-- 文書情報毎の処理 do until(rs.eof or mintDispCount>=mintDefCount) '-- ページ内に表示させるレコード数 mintDispCount=mintDispCount+1 redim preserve marrItems(4,mintDispCount) '-- ID marrItems(0, mintDispCount) = fncNz(rs("ID")) '-- タイトル marrItems(1, mintDispCount) = "" _ & fncNz(rs("fld_title")) & "" '-- 発行年 marrItems(2, mintDispCount)=fncNz(rs("fld_nen")) '-- 記載号 marrItems(3, mintDispCount)=fncNz(rs("fld_go")) '-- 添付画像有無 if rs("fld_files")=1 then if fncNz(rs("fld_filename"))="" then marrItems(4,mintDispCount) = "　" else marrItems(4,mintDispCount) = "" _ & "" end if else marrItems(4,mintDispCount) = "　" end if rs.movenext loop rs.close end sub sub subDispBody() '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' subDispBody() '---------------------------------------------------- '処　理：画面表示 '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim strShori dim arrHeader(4) %> 検索結果一覧画面


表示件数：
　　並べ替え：
検索結果：<%= FormatNumber(mintHitCount,0,true,false,true) & "/" & FormatNumber(mintTotalCount,0,true,false,true) %>件
<%= FormatNumber(mintCurrentPage,0,true,false,true) & "/" & FormatNumber(mintTotalPage,0,true,false,true) %>ページ
検索条件： <%= mstrKensaku %>

<% if mintCurrentPage>1 then %> 先頭ページ　 前ページ <% end if %>　
<% if mintCurrentPage 次ページ　 最終ページ <% end if %>
<% if mintDispCount=0 then response.write "" response.write "" response.write "
該当データはありません。
" response.write "
" else call subDispItems end if %>
<% if mintCurrentPage>1 then %> 先頭ページ　 前ページ <% end if %>　
<% if mintCurrentPage 次ページ　 最終ページ <% end if %>

TOPページへ戻る

<% end sub sub subDispItems() '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* ' subDispItems() '---------------------------------------------------- '処　理：検索結果の表示 '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* dim i %> <% for i=1 to mintDispCount %> <% if (mintDispCount mod 2)=0 then response.write "" else response.write "" end if %> <% mintDispCount = mintDispCount + 1 %> <% next %>
報告書 発行年 記載号 タイトル
<%= marrItems(4,i) %>
<%= marrItems(2,i) %>
<%= marrItems(3,i) %>
 <%= marrItems(1,i) %>

<% end sub %>